home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 001-010 / amok08 / iff8svxload / iff8svxload.mod < prev    next >
Text File  |  1993-11-04  |  26KB  |  913 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    IFF8SVXLoad.mod
  3.     :Author.     Fridtjof Siebert
  4.     :Address.    Nobileweg 67, D-7-Stgt-40
  5.     :Shortcut.   [fbs]
  6.     :Version.    .9
  7.     :Date.       18-Sep-88
  8.     :Copyright.  PD, no commercial use !!!
  9.     :Language.   Modula-II
  10.     :Translator. M2Amiga
  11.     :Imports.    MemSystem [bne], Amok#5
  12.     :UpDate.     none.
  13.     :Contents.   Procedures to load and play sampled sounds.
  14.     :Remark.     Contact me if you want to use this in your own commercial
  15.     :Remark.     Software !
  16. ---------------------------------------------------------------------------*)
  17.  
  18.  
  19. IMPLEMENTATION MODULE IFF8SVXLoad;
  20.  
  21.  
  22. (*------------------------------  IMPORTs:  -------------------------------*)
  23.  
  24.  
  25. (*------  SYSTEM:  ------*)
  26.  
  27. FROM SYSTEM      IMPORT ADR, ADDRESS, LONGSET, SHIFT, CAST;
  28.  
  29. FROM Arts        IMPORT Assert, TermProcedure, BreakPoint;
  30.  
  31. (*------  Libraries:  ------*)
  32.  
  33. FROM Audio       IMPORT IOAudioPtr, IOAudio, audioName, allocFailed, perVol;
  34.  
  35. FROM Dos         IMPORT Open, Close, oldFile, Read, FileHandlePtr, Seek,
  36.                         current;
  37.  
  38. FROM Exec        IMPORT MsgPortPtr, DevicePtr, UByte, Byte, write, IOFlagSet,
  39.                         ReplyMsg, GetMsg, OpenDevice, CopyMem, CloseDevice,
  40.                         WaitPort, AddTask, RemTask, TaskPtr, Forbid, Permit,
  41.                         NodeType, MsgPortAction, FindTask, Wait, Signal,
  42.                         AllocSignal, FreeSignal;
  43.  
  44. FROM ExecSupport IMPORT CreatePort, DeletePort, NewList, BeginIO, AbortIO;
  45.  
  46. (*------  Standard:  ------*)
  47.  
  48. FROM Strings     IMPORT Compare, first, last;
  49.  
  50. (*------  Modules:  ------*)
  51.  
  52. FROM MemSystem   IMPORT ErrHeader, Allocate, AllocMem, Deallocate,
  53.                         YesNoRequest, RETRY, CANCEL, ExitQuiet;
  54.  
  55.  
  56. (*---------------------------  CONSTANTS:  ----------------------------------
  57.  
  58.  
  59. CONST
  60.  
  61.   unity = 10000H;    (* This is Fixed(1) = 1.0000H *)
  62.  
  63.   sCompNone = 0;     (* no compression *)
  64.   sCmpFibDelta = 1;  (* Fibonacci-Delta encoding *)
  65.  
  66.  
  67. (*-----------------------------  TYPEs:  ----------------------------------*)
  68.  
  69.  
  70. TYPE
  71.  
  72.   Fixed = LONGINT;  (* Fixed Point Value (xxxx.xxxxH) *)
  73.  
  74.   IFF8SVXChunks = (VHDR,NAME,COPY,AUTH,ANNO,ATAK,RLSE,BODY);
  75.   IFF8SVXChunkSet = SET OF IFF8SVXChunks;
  76.  
  77. (*------  Type for Data-Chunks:  ------*)
  78.  
  79.   DataChunkPtr = POINTER TO DataChunk;
  80.   DataChunk = RECORD
  81.                 next: DataChunkPtr;  (* to link them *)
  82.                 prev: DataChunkPtr;
  83.                 size: LONGCARD;      (* size of this Chunk *)
  84.                 data: ADDRESS;       (* where to find it   *)
  85.               END;
  86.  
  87. (*------  String:  ------*)
  88.  
  89.   String = ARRAY[0..999] OF CHAR;
  90. (* This is used for smaller strings ! So don't modify them (insert sth.) ! *)
  91.  
  92. (*------  Type to contain loaded data:  ------*)
  93.  
  94.   IFF8SVXInfoPtr = POINTER TO IFF8SVXInfo;
  95.  
  96.   IFF8SVXInfo = RECORD
  97.  
  98.     loadedChunks: IFF8SVXChunkSet;
  99.     (* all Sub-RECORDs whose flag is set here contain legal data *)
  100.  
  101.     next,prev: IFF8SVXInfoPtr;
  102.     (* unused. Can be used to link IFF8SVXInfo's *)
  103.  
  104.     VHDR: RECORD        (* 8SVX's header chunk *)
  105.             oneShotHiSamples: LONGCARD;  (* # of Samples in shotpart Oct.1 *)
  106.             repeatHiSamples: LONGCARD;   (* # of Repeatsamples  in Oct. 1  *)
  107.             samplesPerHiCycle: LONGCARD; (* # Samples/Cycle or 0           *)
  108.             samplesPerSec: CARDINAL;     (* Sampling-rate                  *)
  109.             countOctave: Byte;           (* counts octaves                 *)
  110.             sCompression: Byte;          (* Compression type or 0 if none  *)
  111.             volume: Fixed;               (* Volume (0..10000H)             *)
  112.           END;
  113.  
  114.     NAME: RECORD        (* Sound's Name *)
  115.             size: LONGCARD;              (* Length                         *)
  116.             string: POINTER TO String;   (* Name                           *)
  117.           END;
  118.  
  119.     COPY: RECORD        (* Sound's CopyRight *)
  120.             size: LONGCARD;
  121.             string: POINTER TO String;
  122.           END;
  123.  
  124.     AUTH: RECORD        (* Sound's Author *)
  125.             size: LONGCARD;
  126.             string: POINTER TO String;
  127.           END;
  128.  
  129.     ANNO: RECORD        (* Author's Annotation *)
  130.             size: LONGCARD;
  131.             string: POINTER TO String;
  132.           END;
  133.  
  134.     ATAK,RLSE: RECORD   (* Attack & Decay duration *)
  135.             duration: CARDINAL;          (* Duration in milliseconds       *)
  136.             dest: Fixed;                 (* Destination Volume             *)
  137.           END;
  138.  
  139.     BODY: RECORD        (* Data of sampled Voice *)
  140.             oneChunk: BOOLEAN;           (* Just one Chunk per Octave ?    *)
  141.             maxChunkSize: LONGCARD;      (* Highest Chunk-Size             *)
  142.             dataInChip: BOOLEAN;         (* Chunks in Chip-Memory ?        *)
  143.             soundData: ARRAY[0..7] OF DataChunkPtr;(* <= 8 Octaves of Data *)
  144.           END;
  145.   END;
  146.  
  147. (*------  Errors:  ------*)
  148.  
  149.  
  150.   IFF8SVXErrs = (iff8OK,iff8OutOfMem,iff8Openfailed,iff8Readfailed,iff8NoIFF,
  151.                  iff8NoChannel,iff8OpenDevicefailed);
  152.  
  153.  
  154. (*---------------------------  Variables:  --------------------------------*)
  155.  
  156.  
  157. VAR
  158.   IFF8SVXError: IFF8SVXErrs;   (* Last Error *)
  159.  
  160.  
  161. ---------------------------  internal Variables:  -------------------------*)
  162.  
  163.  
  164. TYPE
  165.   ExtIOAudio = RECORD
  166.                  ioa: IOAudio;
  167.                  id: CARDINAL;
  168.                END;
  169.   ExtIOAudioPtr = POINTER TO ExtIOAudio;
  170.  
  171. VAR
  172.   InH: FileHandlePtr;
  173.   Buffer: ADDRESS;             (* Buffer for Reading / Writing             *)
  174.   TextBuffer: POINTER TO ARRAY[0..63] OF ARRAY[0..3] OF CHAR;
  175.   LONGBuffer: POINTER TO ARRAY[0..63] OF LONGCARD;
  176.   WORDBuffer: POINTER TO ARRAY[0..127] OF CARDINAL;
  177.   LongPtr,LONGPtr: POINTER TO LONGCARD;
  178.   i,j: LONGCARD;
  179.   len: LONGCARD;               (* number of bytes read from file *)
  180.   ChunkSize: LONGCARD;         (* size of loaded octave *)
  181.  
  182.   AllocPort:  MsgPortPtr;
  183.   AllocIOB:   IOAudioPtr;
  184.   Device:     DevicePtr;
  185.   SoundPort:  MsgPortPtr;
  186.   SoundIOB:   IOAudioPtr;
  187.   AllocationMap: ARRAY[0..3] OF Byte;
  188.   SoundXIOA:  ARRAY[0..3],[0..1] OF ExtIOAudioPtr;
  189.   SoundInfo:  ARRAY[0..3] OF RECORD
  190.                 info:    IFF8SVXInfoPtr;
  191.                 chunk:   DataChunkPtr;              (* active Chunk        *)
  192.                 oct:     CARDINAL;                  (* octave to play      *)
  193.                 repCnt:  CARDINAL;                  (* how often to repeat *)
  194.                 bufSize: LONGCARD;                  (* size of Buffer      *)
  195.                 playing: BOOLEAN;                   (* playing or ready ?  *)
  196.                 done:    BOOLEAN;                   (* sound played ?      *)
  197.                 dblBuf:  BOOLEAN;                   (* DoubleBuffering ?   *)
  198.               END;
  199.   ChannelDone: ARRAY[0..3] OF ExtIOAudioPtr;
  200.   PlayTask :  TaskPtr;
  201.   PlayStack:  ADDRESS;
  202.   SoundSignal: LONGINT;
  203.   SoundTask:  TaskPtr;
  204.  
  205.  
  206. (*------  Load an Octave:  ------*)
  207.  
  208.  
  209. PROCEDURE LoadChunk(Size,MaxSize: LONGCARD;
  210.                     Prev: DataChunkPtr;
  211.                     ChipMem: BOOLEAN): DataChunkPtr;
  212.  
  213. VAR
  214.   Chunk: DataChunkPtr;
  215.  
  216. BEGIN
  217.   Allocate(Chunk,SIZE(DataChunk));
  218.   IF Chunk=NIL THEN
  219.     IFF8SVXError := iff8OutOfMem;
  220.     RETURN NIL;
  221.   END;
  222.   WITH Chunk^ DO
  223.     prev := Prev;
  224.     IF (Size<=MaxSize) OR (MaxSize=0) THEN
  225.       size := Size;
  226.     ELSE
  227.       size := MaxSize;
  228.     END;
  229.     DEC(Size,size);
  230.     AllocMem(data,size,ChipMem);
  231.     IF data=NIL THEN
  232.       IFF8SVXError := iff8OutOfMem;
  233.       Deallocate(Chunk);
  234.       RETURN NIL;
  235.     END;
  236.     len := Read(InH,data,size);
  237.     IF len#size THEN
  238.       IFF8SVXError := iff8Readfailed;
  239.       Deallocate(data);
  240.       Deallocate(Chunk);
  241.       RETURN NIL;
  242.     END;
  243.     IF Size#0 THEN
  244.       next := LoadChunk(Size,MaxSize,Chunk,ChipMem);
  245.       IF next=NIL THEN
  246.         Deallocate(data);
  247.         Deallocate(Chunk);
  248.         RETURN NIL;
  249.       END;
  250.     ELSE
  251.       next := NIL;
  252.     END;
  253.  
  254.   END;   (* WITH Chunk^ DO *)
  255.  
  256.   RETURN Chunk;
  257.  
  258. END LoadChunk;
  259.  
  260.  
  261. (*-------------------------------------------------------------------------*)
  262. (*                                                                         *)
  263. (*                          Load Sampled Sound:                            *)
  264. (*                                                                         *)
  265. (*-------------------------------------------------------------------------*)
  266.  
  267.  
  268. PROCEDURE Read8SVX(Name: ARRAY OF CHAR;
  269.                    MaxChunkSize: LONGCARD;
  270.                    ChipMem: BOOLEAN): IFF8SVXInfoPtr;
  271. (* Name:         Sound's Name                                              *)
  272. (* MaxChunkSize: MaxSize of Data-Chunk or 0 to load to a single chunk      *)
  273. (* ChipMem:      TRUE if you want all chunks in ChipMem.                   *)
  274. (* Resul:        Pointer to info of loaded sample or NIL if any error      *)
  275. (*               occured. IFF8SVXError contains errortype.                 *)
  276.  
  277. VAR
  278.   Info: IFF8SVXInfoPtr;
  279.  
  280. BEGIN
  281.  
  282.   IFF8SVXError := iff8OK;
  283.   Allocate(Info,SIZE(Info^));
  284.   IF Info=NIL THEN
  285.     IFF8SVXError := iff8OutOfMem;
  286.     RETURN NIL;
  287.   END;
  288.  
  289. (*------  Open File:  ------*)
  290.  
  291.   LOOP
  292.  
  293.     InH := Open(ADR(Name),oldFile);
  294.     IF InH=NIL THEN
  295.       IFF8SVXError := iff8Openfailed;
  296.       EXIT;
  297.     END;
  298.  
  299. (*------  File Header:  ------*)
  300.  
  301.     len := Read(InH,Buffer,12);
  302.     IF len=0 THEN
  303.       IFF8SVXError := iff8Readfailed;
  304.       EXIT;
  305.     END;
  306.     IF (Compare(TextBuffer^[0],first,4,"FORM",TRUE)#0) OR
  307.        (Compare(TextBuffer^[2],first,4,"8SVX",TRUE)#0) THEN
  308.       IFF8SVXError := iff8NoIFF;
  309.       EXIT;
  310.     END;
  311.  
  312. (*------  Main Loop:  ------*)
  313.  
  314.     LOOP
  315.  
  316.       len := Read(InH,Buffer,8);
  317.  
  318.       IF len#8 THEN
  319.         IFF8SVXError := iff8Readfailed;
  320.         EXIT;
  321.       END;
  322.  
  323. (*------  VHDR:  ------*)
  324.  
  325.       IF Compare(TextBuffer^[0],first,4,"VHDR",TRUE)=0 THEN
  326.         INCL(Info^.loadedChunks,VHDR);
  327.         len := Read(InH,Buffer,LONGBuffer^[1]);
  328.         LONGPtr := Buffer;
  329.         LongPtr := ADR(Info^.VHDR);
  330.         FOR i:=0 TO 4 DO
  331.           LongPtr^ := LONGPtr^;
  332.           INC(LongPtr,4);
  333.           INC(LONGPtr,4);
  334.         END;
  335.  
  336. (*------  NAME:  ------*)
  337.  
  338.       ELSIF Compare(TextBuffer^[0],first,4,"NAME",TRUE)=0 THEN
  339.         INCL(Info^.loadedChunks,NAME);
  340.         WITH Info^.NAME DO
  341.           size := LONGBuffer^[1]+1;
  342.           AllocMem(string,size,TRUE);
  343.           IF string=NIL THEN IFF8SVXError := iff8OutOfMem; EXIT END;
  344.           len := Read(InH,string,size-1);
  345.           IF ODD(size-1) THEN len := Read(InH,Buffer,1) END;
  346.         END;
  347.  
  348. (*------  COPY:  ------*)
  349.  
  350.       ELSIF Compare(TextBuffer^[0],first,4,"(c) ",TRUE)=0 THEN
  351.         INCL(Info^.loadedChunks,COPY);
  352.         WITH Info^.COPY DO
  353.           size := LONGBuffer^[1]+1;
  354.           AllocMem(string,size,TRUE);
  355.           IF string=NIL THEN IFF8SVXError := iff8OutOfMem; EXIT END;
  356.           len := Read(InH,string,size-1);
  357.           IF ODD(size-1) THEN len := Read(InH,Buffer,1) END;
  358.         END;
  359.  
  360. (*------  AUTH:  ------*)
  361.  
  362.       ELSIF Compare(TextBuffer^[0],first,4,"AUTH",TRUE)=0 THEN
  363.         INCL(Info^.loadedChunks,AUTH);
  364.         WITH Info^.AUTH DO
  365.           size := LONGBuffer^[1]+1;
  366.           AllocMem(string,size,TRUE);
  367.           IF string=NIL THEN IFF8SVXError := iff8OutOfMem; EXIT END;
  368.           len := Read(InH,string,size-1);
  369.           IF ODD(size-1) THEN len := Read(InH,Buffer,1) END;
  370.         END;
  371.  
  372. (*------  ANNO:  ------*)
  373.  
  374.       ELSIF Compare(TextBuffer^[0],first,4,"ANNO",TRUE)=0 THEN
  375.         INCL(Info^.loadedChunks,ANNO);
  376.         WITH Info^.ANNO DO
  377.           size := LONGBuffer^[1]+1;
  378.           AllocMem(string,size,TRUE);
  379.           IF string=NIL THEN IFF8SVXError := iff8OutOfMem; EXIT END;
  380.           len := Read(InH,string,size-1);
  381.           IF ODD(size-1) THEN len := Read(InH,Buffer,1) END;
  382.         END;
  383.  
  384. (*------  ATAK:  ------*)
  385.  
  386.       ELSIF Compare(TextBuffer^[0],first,4,"ATAK",TRUE)=0 THEN
  387.         INCL(Info^.loadedChunks,ATAK);
  388.         len := Read(InH,Buffer,LONGBuffer^[1]);
  389.         Info^.ATAK.duration := WORDBuffer^[0];
  390.         LONGPtr := ADDRESS(LONGCARD(Buffer) + 2);
  391.         Info^.ATAK.dest := LONGPtr^;
  392.  
  393. (*------  RLSE:  ------*)
  394.  
  395.       ELSIF Compare(TextBuffer^[0],first,4,"RLSE",TRUE)=0 THEN
  396.         INCL(Info^.loadedChunks,RLSE);
  397.         len := Read(InH,Buffer,LONGBuffer^[1]);
  398.         Info^.RLSE.duration := WORDBuffer^[0];
  399.         LONGPtr := ADDRESS(LONGCARD(Buffer) + 2);
  400.         Info^.RLSE.dest := LONGPtr^;
  401.  
  402. (*------  BODY:  ------*)
  403.  
  404.       ELSIF Compare(TextBuffer^[0],first,4,"BODY",TRUE)=0 THEN
  405.         IF NOT(VHDR IN Info^.loadedChunks) THEN
  406.           IFF8SVXError := iff8NoIFF;
  407.           EXIT;
  408.         END;
  409.         INCL(Info^.loadedChunks,BODY);
  410.         WITH Info^.BODY DO
  411.           oneChunk := TRUE;
  412.           dataInChip := ChipMem;
  413.           WITH Info^.VHDR DO
  414.             ChunkSize := oneShotHiSamples + repeatHiSamples;
  415.             FOR i:=0 TO Info^.VHDR.countOctave-1 DO
  416.               soundData[i] := LoadChunk(ChunkSize,MaxChunkSize,NIL,ChipMem);
  417.               IF soundData[i]=NIL THEN EXIT END;
  418.               maxChunkSize := ChunkSize;
  419.               INC(ChunkSize,ChunkSize);
  420.             END;
  421.             IF maxChunkSize>MaxChunkSize THEN
  422.               maxChunkSize := MaxChunkSize;
  423.             END;
  424.           END;
  425.         END;
  426.         EXIT;
  427.  
  428. (*------  Unknown Chunk:  ------*)
  429.  
  430.       ELSE
  431.         IF ODD(LONGBuffer^[1]) THEN
  432.           len := Seek(InH,current,LONGBuffer^[1]+1);
  433.         ELSE
  434.           len := Seek(InH,current,LONGBuffer^[1]);
  435.         END;
  436.       END;
  437.  
  438.     END;   (* LOOP *)
  439.  
  440. (*------  EXIT & Error check:  ------*)
  441.  
  442.     IF NOT((VHDR IN Info^.loadedChunks) OR (BODY IN Info^.loadedChunks)) THEN
  443.       IFF8SVXError := iff8NoIFF;
  444.     END;
  445.  
  446.     EXIT;
  447.  
  448.   END;   (* LOOP *)
  449.  
  450.   IF IFF8SVXError#iff8OK THEN
  451.     Dealloc8SVX(Info);
  452.     Info := NIL;
  453.   END;
  454.  
  455.   Close(InH); InH := NIL;
  456.  
  457.   RETURN Info;
  458.  
  459. END Read8SVX;
  460.  
  461.  
  462. (*------  Free DataChunk's Memory:  ------*)
  463.  
  464.  
  465. PROCEDURE FreeChunks(first: DataChunkPtr);
  466.  
  467. BEGIN
  468.   WITH first^ DO
  469.     IF next#NIL THEN FreeChunks(next) END;
  470.     IF data#NIL THEN
  471.       Deallocate(data);
  472.     END;
  473.   END;
  474.   Deallocate(first);
  475. END FreeChunks;
  476.  
  477.  
  478. (*-------------------------------------------------------------------------*)
  479. (*                                                                         *)
  480. (*                         Free Sound's Memory:                            *)
  481. (*                                                                         *)
  482. (*-------------------------------------------------------------------------*)
  483.  
  484.  
  485. PROCEDURE Dealloc8SVX(Info:IFF8SVXInfoPtr);
  486.  
  487. (* Info: Sound's Info-Record                                               *)
  488.  
  489. VAR
  490.   i: CARDINAL;
  491.  
  492. BEGIN
  493.   IF Info#NIL THEN
  494.     IF NAME IN Info^.loadedChunks THEN
  495.       WITH Info^.NAME DO
  496.         IF string#NIL THEN Deallocate(string) END;
  497.       END;
  498.     END;
  499.     IF COPY IN Info^.loadedChunks THEN
  500.       WITH Info^.COPY DO
  501.         IF string#NIL THEN Deallocate(string) END;
  502.       END;
  503.     END;
  504.     IF AUTH IN Info^.loadedChunks THEN
  505.       WITH Info^.AUTH DO
  506.         IF string#NIL THEN Deallocate(string) END;
  507.       END;
  508.     END;
  509.     IF ANNO IN Info^.loadedChunks THEN
  510.       WITH Info^.ANNO DO
  511.         IF string#NIL THEN Deallocate(string) END;
  512.       END;
  513.     END;
  514.     IF BODY IN Info^.loadedChunks THEN
  515.       FOR i:=0 TO Info^.VHDR.countOctave-1 DO
  516.         IF Info^.BODY.soundData[i]#NIL THEN
  517.           FreeChunks(Info^.BODY.soundData[i]);
  518.         END;
  519.       END;
  520.     END;
  521.     Deallocate(Info);
  522.   END;
  523. END Dealloc8SVX;
  524.  
  525.  
  526. (*------  Task to play Sound:  ------*)
  527.  
  528.  
  529. PROCEDURE PlayTaskProc(); (* $S- *)
  530.  
  531. VAR
  532.   XIOA: ExtIOAudioPtr;
  533.   i: CARDINAL;
  534.  
  535. BEGIN
  536.   LOOP
  537.     WaitPort(SoundPort);
  538.     XIOA := GetMsg(SoundPort);
  539.     IF (XIOA#NIL) AND (XIOA^.ioa.request.error=0) THEN
  540.       WITH SoundInfo[XIOA^.id] DO
  541.         Forbid();
  542.         IF done THEN
  543.           ChannelDone[XIOA^.id] := NIL;
  544.         END;
  545.         IF playing THEN
  546.           IF chunk^.next#NIL THEN
  547.             chunk := chunk^.next;
  548.           ELSIF repCnt>1 THEN
  549.             DEC(repCnt);
  550.             chunk := info^.BODY.soundData[oct];
  551.           ELSE
  552.             done := TRUE;
  553.             ChannelDone[XIOA^.id] := XIOA;
  554.             playing := FALSE;
  555.             Signal(SoundTask,LONGSET{SoundSignal})
  556.           END;
  557.         END;
  558.         IF NOT(done) THEN
  559.           playing := TRUE;
  560.           IF dblBuf THEN
  561.             CopyMem(chunk^.data,XIOA^.ioa.data,chunk^.size);
  562.           ELSE
  563.             XIOA^.ioa.data   := chunk^.data;
  564.           END;
  565.           XIOA^.ioa.length := chunk^.size;
  566.           BeginIO(XIOA);
  567.         END;
  568.         Permit();
  569.       END;   (* WITH SoundInfo[XIOA^.id] *)
  570.     END;   (* IF Msg ok  THEN *)
  571.   END;   (* endless LOOP *)
  572. END PlayTaskProc;
  573.  
  574.  
  575. (*-------------------------------------------------------------------------*)
  576. (*                                                                         *)
  577. (*                         Open Audio Device:                              *)
  578. (*                                                                         *)
  579. (*-------------------------------------------------------------------------*)
  580.  
  581.  
  582. PROCEDURE OpenAudio(Channels: CARDINAL; Priority: Byte): BOOLEAN;
  583.  
  584. (* Channels: Number of soundchannels to allocate                           *)
  585. (* Prioriy:  Allocation Priority                                           *)
  586.  
  587. BEGIN
  588.  
  589.   IFF8SVXError := iff8OK;
  590.  
  591. (*------  Allocation Precedence and Channel:  ------*)
  592.  
  593.   AllocIOB^.request.message.node.pri := -40;
  594.   AllocIOB^.request.message.replyPort:= AllocPort;
  595.  
  596.   CASE Channels OF
  597.   1: AllocationMap[0] :=  1;
  598.      AllocationMap[1] :=  2;
  599.      AllocationMap[2] :=  4;
  600.      AllocationMap[3] :=  8; |
  601.   2: AllocationMap[0] :=  3;
  602.      AllocationMap[1] :=  6;
  603.      AllocationMap[2] := 12;
  604.      AllocationMap[3] :=  5; |
  605.   3: AllocationMap[0] := 14;
  606.      AllocationMap[1] := 13;
  607.      AllocationMap[2] := 11;
  608.      AllocationMap[3] :=  7; |
  609.   4: AllocationMap[0] := 15;
  610.      AllocationMap[1] := 15;
  611.      AllocationMap[2] := 15;
  612.      AllocationMap[3] := 15; |
  613.   END;
  614.   AllocIOB^.data   := ADR(AllocationMap);
  615.   AllocIOB^.length := SIZE(AllocationMap);
  616.  
  617. (*------  Open Audio-Device:  ------*)
  618.  
  619.   OpenDevice(ADR(audioName),0,AllocIOB,LONGSET{});
  620. (* Why doesn't OpenDevice() return it's error ??? *)
  621.  
  622.   CASE AllocIOB^.request.error OF
  623.   -1,allocFailed:
  624.     IFF8SVXError := iff8OpenDevicefailed;
  625.     RETURN FALSE |
  626.   ELSE
  627.   END;
  628.  
  629.   Device := AllocIOB^.request.device;
  630.  
  631. (*------  Initialize ReplyPort:  ------*)
  632.  
  633.   WITH SoundPort^ DO
  634.     flags     := signal;
  635.     node.type := msgPort;
  636.   END;
  637.   NewList(ADR(SoundPort^.msgList));
  638.  
  639. (*------  Initialize I/O-Block:  ------*)
  640.  
  641.   j := 0;
  642.   FOR i:=0 TO 3 DO
  643.     WITH SoundXIOA[i,0]^ DO
  644.       id := i;
  645.       ioa.request.message.replyPort := SoundPort;
  646.       ioa.request.device  := Device;
  647.       WHILE (j<4) AND NOT(j IN CAST(LONGSET,AllocIOB^.request.unit)) DO
  648.         INC(j);
  649.       END;
  650.       IF j<4 THEN
  651.         ioa.request.unit    := CAST(ADDRESS,LONGSET{j});
  652.         DEC(Channels,1);
  653.       ELSE
  654.         ioa.request.unit    := NIL;
  655.       END;
  656.       INC(j);
  657.       ioa.request.command := write;
  658.       ioa.request.flags   := IOFlagSet{4}; (* perVol *)
  659.       ioa.allocKey        := AllocIOB^.allocKey;
  660.     END;
  661.     SoundXIOA[i,1]^ := SoundXIOA[i,0]^;
  662.     SoundInfo[i].playing := FALSE;
  663.     SoundInfo[i].done    := TRUE;
  664.     ChannelDone[i]       := NIL;
  665.   END;
  666.  
  667. (*------  Start PlayTask:  ------*)
  668.  
  669.   Allocate(PlayTask,SIZE(PlayTask^));
  670.   IF PlayTask=NIL THEN ExitQuiet END;
  671.   SoundPort^.sigTask := PlayTask;
  672.   WITH PlayTask^ DO
  673.     spLower := PlayStack;
  674.     spUpper := ADDRESS(LONGCARD(PlayStack) + 1000);
  675.     spReg   := spUpper;
  676.     node.type := task;
  677.     node.name := ADR("SamplePlayTask");
  678.   END;
  679.   AddTask(PlayTask,ADR(PlayTaskProc),NIL);
  680.  
  681.   IF Channels>0 THEN
  682.     CloseAudio();
  683.     IFF8SVXError := iff8NoChannel;
  684.     RETURN FALSE;
  685.   END;
  686.  
  687.   RETURN TRUE;
  688.  
  689. END OpenAudio;
  690.  
  691.  
  692. (*-------------------------------------------------------------------------*)
  693. (*                                                                         *)
  694. (*                         Close Audio Device:                             *)
  695. (*                                                                         *)
  696. (*-------------------------------------------------------------------------*)
  697.  
  698.  
  699. PROCEDURE CloseAudio();
  700.  
  701.  
  702. BEGIN
  703.   RemTask(PlayTask);
  704.   Deallocate(PlayTask);
  705.   PlayTask := NIL;
  706.   CloseDevice(AllocIOB);
  707.   Device := NIL;
  708.   FOR i:=0 TO 3 DO
  709.     IF SoundInfo[i].dblBuf THEN
  710.       WITH SoundXIOA[i,0]^.ioa DO
  711.         IF data#NIL THEN Deallocate(data) END;
  712.       END;
  713.       WITH SoundXIOA[i,1]^.ioa DO
  714.         IF data#NIL THEN Deallocate(data) END;
  715.       END;
  716.     END;
  717.   END;
  718. END CloseAudio;
  719.  
  720.  
  721. (*-------------------------------------------------------------------------*)
  722. (*                                                                         *)
  723. (*                         Play sampled Sound:                             *)
  724. (*                                                                         *)
  725. (*-------------------------------------------------------------------------*)
  726.  
  727.  
  728. PROCEDURE PlaySample(Info:    IFF8SVXInfoPtr;
  729.                      Octave:  INTEGER;
  730.                      Repeat:  CARDINAL;
  731.                      Channel: CARDINAL): BOOLEAN;
  732.  
  733. (* Info:    Sound's IFF8SVXInfo                                            *)
  734. (* Octave:  Octave to play (0..7)                                          *)
  735. (* Repeat:  how often to repeat sound                                      *)
  736. (* Channel: Channel to play sound                                          *)
  737.  
  738. VAR
  739.   Reply: BOOLEAN;
  740.  
  741. (*------  Fun Starts:  ------*)
  742.  
  743. BEGIN
  744.  
  745.   IF Info=NIL THEN
  746.     IFF8SVXError := iff8NoIFF;
  747.     RETURN FALSE;
  748.   END;
  749.  
  750.   IF Octave >= Info^.VHDR.countOctave THEN RETURN TRUE END;
  751.  
  752.   WITH SoundInfo[Channel] DO
  753.     Forbid();
  754.     Reply := done;
  755.     AbortIO(SoundXIOA[Channel,0]);
  756.     AbortIO(SoundXIOA[Channel,1]);
  757.     WITH Info^ DO
  758.       info := Info;
  759.       chunk := BODY.soundData[Octave];
  760.       oct := Octave;
  761.       repCnt := Repeat;
  762.       playing := FALSE;
  763.       done    := FALSE;
  764.       bufSize := Info^.BODY.maxChunkSize;
  765.       IF dblBuf THEN
  766.         FOR i:=0 TO 1 DO
  767.           WITH SoundXIOA[Channel,i]^.ioa DO
  768.             IF data#NIL THEN Deallocate(data) END;
  769.           END;
  770.         END;
  771.       END;
  772.       dblBuf := NOT(BODY.dataInChip);
  773.       FOR i:=0 TO 1 DO;
  774.         WITH SoundXIOA[Channel,i]^.ioa DO
  775.           period        := LONGINT(3584200) DIV LONGINT(VHDR.samplesPerSec);
  776.           volume        := SHIFT(VHDR.volume,-10);
  777.           cycles        := 1;
  778.           IF dblBuf  THEN
  779.             AllocMem(data,bufSize,TRUE);
  780.             IF data=NIL THEN
  781.               IFF8SVXError := iff8OutOfMem;
  782.               RETURN FALSE;
  783.             END;
  784.           ELSE
  785.             data := NIL;
  786.           END;
  787.         END;
  788.       END;
  789.       IF Reply THEN
  790.         IF ChannelDone[Channel] = NIL THEN
  791.           ReplyMsg(SoundXIOA[Channel,0]);
  792.           ReplyMsg(SoundXIOA[Channel,1]);
  793.         ELSE
  794.           ReplyMsg(ChannelDone[Channel]);
  795.         END;
  796.       END;
  797.     END;
  798.     Permit();
  799.   END;
  800.  
  801.   IFF8SVXError := iff8OK;
  802.  
  803.   RETURN TRUE;
  804.  
  805. END PlaySample;
  806.  
  807.  
  808. (*-------------------------------------------------------------------------*)
  809. (*                                                                         *)
  810. (*                       Wait for Play to finish:                          *)
  811. (*                                                                         *)
  812. (*-------------------------------------------------------------------------*)
  813.  
  814. (*
  815. CONST
  816.   AllChannels = 4;
  817. *)
  818.  
  819. PROCEDURE WaitPlay(Channel: CARDINAL);
  820.  
  821. (* This waits for a channel to complete.                                   *)
  822. (* WaitPlay(AllChannels) waits for all channels to finish.                 *)
  823.  
  824. VAR
  825.   i: CARDINAL;
  826.   x: BOOLEAN;
  827.  
  828. BEGIN
  829.   IF Channel<AllChannels THEN
  830.     IF NOT(SoundInfo[Channel].done) THEN
  831.       IF Wait(LONGSET{SoundSignal})=LONGSET{} THEN END;
  832.     END;
  833.   ELSE
  834.     LOOP
  835.       x := TRUE;
  836.       FOR i:=0 TO 3 DO
  837.         x := x AND SoundInfo[i].done;
  838.       END;
  839.       IF x THEN EXIT END;
  840.       IF Wait(LONGSET{SoundSignal})=LONGSET{} THEN END;
  841.     END;
  842.   END;
  843. END WaitPlay;
  844.  
  845.  
  846. (*------  CleanUp:  ------*)
  847.  
  848.  
  849. PROCEDURE CleanUp();
  850.  
  851. BEGIN
  852.   IF PlayTask #NIL THEN
  853.     RemTask(PlayTask);
  854.     Deallocate(PlayTask);
  855.   END;
  856.   IF Device#NIL THEN CloseDevice(AllocIOB) END;
  857.   IF Buffer#NIL    THEN Deallocate(Buffer) END;
  858.   IF InH#NIL       THEN Close(InH) END;
  859.   IF AllocIOB #NIL THEN Deallocate(AllocIOB ) END;
  860.   IF AllocPort#NIL THEN DeletePort(AllocPort) END;
  861.   IF SoundPort#NIL THEN Deallocate(SoundPort) END;
  862.   IF PlayStack#NIL THEN Deallocate(PlayStack) END;
  863.   FOR i:=0 TO 3 DO
  864.     IF SoundInfo[i].dblBuf THEN
  865.       WITH SoundXIOA[i,0]^.ioa DO
  866.         IF data#NIL THEN Deallocate(data) END;
  867.       END;
  868.       WITH SoundXIOA[i,1]^.ioa DO
  869.         IF data#NIL THEN Deallocate(data) END;
  870.       END;
  871.     END;
  872.     IF SoundXIOA[i,0]#NIL THEN Deallocate(SoundXIOA[i,0]) END;
  873.     IF SoundXIOA[i,1]#NIL THEN Deallocate(SoundXIOA[i,1]) END;
  874.   END;
  875.   FreeSignal(SoundSignal);
  876. END CleanUp;
  877.  
  878.  
  879. (*-------------------------  Initialization:  -----------------------------*)
  880.  
  881.  
  882. BEGIN
  883.   ErrHeader := "Error loading Sampled Sound:";
  884.   AllocMem(Buffer,768,TRUE);
  885.   Assert(Buffer#NIL,ADR("Not enough ChipMem !!!"));
  886.   TextBuffer := Buffer;
  887.   LONGBuffer := Buffer;
  888.   WORDBuffer := Buffer;
  889.   InH := NIL;
  890.   AllocPort := CreatePort(ADR("Sampled SoundPort"),0);
  891.   IF AllocPort=NIL THEN ExitQuiet END;
  892.   Allocate(AllocIOB,SIZE(AllocIOB^));
  893.   IF AllocPort=NIL THEN ExitQuiet END;
  894.   FOR i:=0 TO 3 DO
  895.     Allocate(SoundXIOA[i,0],SIZE(ExtIOAudio));
  896.     IF SoundXIOA[i,0]=NIL THEN ExitQuiet END;
  897.     Allocate(SoundXIOA[i,1],SIZE(ExtIOAudio));
  898.     IF SoundXIOA[i,1]=NIL THEN ExitQuiet END;
  899.     SoundInfo[i].dblBuf := FALSE;
  900.     SoundInfo[i].done := TRUE;
  901.   END;
  902.   Allocate(SoundPort,SIZE(SoundPort^));
  903.   IF SoundPort=NIL THEN ExitQuiet END;
  904.   Allocate(PlayStack,1000);
  905.   IF PlayStack=NIL THEN ExitQuiet END;
  906.   PlayTask := NIL;
  907.   SoundSignal := AllocSignal(-1);
  908.   Assert(SoundSignal>0,ADR("No more Signalbits !!!"));
  909.   SoundTask := FindTask(0);
  910.   Device := NIL;
  911.   TermProcedure(CleanUp);
  912. END IFF8SVXLoad.
  913.